home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994 June: Reference Library / Dev.CD Jun 94.toast / Periodicals / develop / develop Issue 11 / develop 11 code / The NetWork Project / NetWork Programmer's Stuff / NetWork.p < prev    next >
Encoding:
Text File  |  1992-07-15  |  30.9 KB  |  976 lines  |  [TEXT/MPS ]
  1. { © Copyright 1989,90,91 The NetWork Project, StatLab Heidelberg.
  2.   © Copyright 1989,90,91 Joachim Lindenberg, Karlsruhe,
  3.                          Günther Sawitzki, Heidelberg. All rights reserved. }
  4.  
  5. { This library does not support code without an A5 world. If you want to use
  6.   NetWork from other code (non application, non tool), you´ll have to use
  7.   control calls to the driver directly. Contact us if you need help with that.
  8.   
  9.   The library uses a call to NetWork Processor to find out whether this process
  10.   is already known to NetWork. If it is, it is assumed to be launched by NetWork
  11.   by means of a message or idle time launch, and the type and signature are confirmed.
  12.   If it is not known, the process is registered using the default type and the
  13.   application´s signature. The default type is pMaster unless you set pDefault to
  14.   something different. It is allowed to use pSlave or pLocal even if not launched
  15.   automatically, and the process will be subject to the rules of slave/local
  16.   processes in that case.
  17. }
  18.  
  19. {$IFC UNDEFINED UsingIncludes}
  20. {$SETC UsingIncludes:=false}
  21. {$ENDC}
  22.  
  23. unit NetWork;
  24.  
  25. interface
  26.  
  27. { a star indicates that NetWork depends on these units, other comments indicate which unit
  28.   requires the inclusion of this unit. Tripple stars mark the units that are required
  29.   by the interface part of NetWork. If you use NetWork, but don´t use these units prior
  30.   to NetWork, NetWork will automatically include them. Note that conscious use of uses
  31.   will speed your compiles considerably. }
  32.   
  33. uses    Types {***}, FixMath {Packages}, QuickDraw {***lots of other units***},
  34.         Events {*}, OSUtils {***}, SegLoad {Files}, Files {Devices, StandardFile/Packages}, Devices {*},
  35.         Errors {*}, Memory {*}, Resources {*},
  36.         Packages {*}, SysEqu {*}, Traps {*},
  37.         ToolUtils {NetWorkLookup}, AppleTalk {NetWorkLookup};
  38.  
  39. {$I+}
  40. {$SETC NetWorkIncludes:=UsingIncludes}
  41. {$SETC UsingIncludes:=true}
  42. {$SETC UsingNetWork:=true}
  43. {$SETC UsingNetWorkUtilities:=true}
  44.  
  45. {$IFC UNDEFINED UsingTypes}
  46. {$I $$SHELL(PInterfaces)Types.p}
  47. {$ENDC}
  48.  
  49. {$IFC UNDEFINED UsingOSUtils}
  50. {$I $$SHELL(PInterfaces)OSUtils.p}
  51. {$ENDC}
  52.  
  53. {$SETC UsingIncludes:=NetWorkIncludes}
  54.  
  55.  
  56. {    =============================================================    }
  57.  
  58. { global declarations - general use }
  59.  
  60. const 
  61.  
  62. { general error messages - many of them are never returned to user processes.
  63.   Also other operating system error codes may bubble up. }
  64.  
  65. { some of these codes should be reconsidered, also some of them could be more specific }
  66.  
  67.     eQueEmpty        = -31000;    { no more messages avail - out of memory }
  68. {    eMsg2Big        = ?            { message (priority + standard) too big }
  69.     ePrio2Big        = -31001;    { priority information too big }
  70. {    eCore2Big        = ?            { core information too big }
  71.     eNoSuchMsg        = -31002;    { invalid or NIL message reference, no message avail (GET) }
  72.     eNotLaunched    = -31003;    { destination process does not exist - NOT USED }
  73.     eAbortMsg        = -31004;    { message transfer aborted }
  74.     eProcTableFull     = -31005;    { process table full (Init/Exit) }
  75.     eNoSuchProcess    = -31006;    { specified process unknown }
  76.     eNoMoreDynamics    = -31007;    { maximum number of dynamic ids exceeded }
  77.     eLaunchFailed    = -31008;    { launch failed - NOT USED }
  78.     eInvalid        = -31009;    { local message transfer aborted }
  79.     eSizeLimit        = -31010;    { message larger than supported by transport - AppleTalk broadcast - eMsg2Big }
  80.     eVersion        = -31011;    { version of library/driver/transport/system }
  81.     eProtType        = -31012;    { no transport, invalid network address - Dispatcher }
  82.     eLoopback        = -31013;    { discard of broadcasted message - NEVER returned to user }
  83.     eTransportDown    = -31014;    { transport system not available - AppleTalk }
  84.     eCmdSequence    = -31015;    { cmd sequencing error - bug of NetWork Processor or Dispatcher }
  85.     eProtIndex        = -31016;    { protocol index out of range - GetTransport }
  86.     eProcessExists    = -31017;    { creator registered for a DIFFERENT process - process mgmt }
  87.     eProcessIndex    = -31018;    { invalid process index - GetIndexedProcess }
  88.     eProcessType    = -31019;    { process type illegal or does not match launch - process mgmt }
  89.     eRestartListen    = -31020;    { a listener handled a request for more data,
  90.                                   and requires a restart therefore - AppleTalk - NEVER returned to user }
  91.     eMsgTimeout        = -31021;    { maximum message lifetime exceeded - AppleTalk }
  92.     eNoSignature    = -31022;    { couldn´t obtain signature of application file - Library }
  93.     eMsgLockFailed    = -31023;    { couldn´t lock message - NOT USED }
  94.     eSigTableFull    = -31024;    { signature table full }
  95.     eSigRegistered    = -31025;    { signature already registered }
  96.     eSigNotRegistered = -31026;    { signature not registered }
  97.     eProcMgmtError  = -31027;    { internal error }
  98.     eSourceSig        = -31028;    { source signature wrong in Send/Post }
  99.     eSourceAddr        = -31029;    { source address wrong in Send/Post }
  100.     
  101. { capas defined }
  102.  
  103.     cMustExist        = $80000000;    { process must exist -- don´t launch }
  104.     
  105. { idle monitor states - see NetWork TN 12 Idle Monitor States }
  106.  
  107.     imBusy        =  0;
  108.     imIdle        =  1;
  109.     imActive    =  2;
  110.     imLoaded    =  3;
  111.     
  112. { process types - see NetWork Communications }
  113.  
  114.     pUnknown    =  0;
  115.     pSlave        =  1;
  116.     pLocal        =  2;
  117.     pMaster        =  3;
  118.     
  119. { transport system constants }
  120.  
  121. { major command codes }
  122.  
  123.     tGeneral    = $00;
  124.     tListen        = $10;
  125.     tGet        = $20;
  126.     tAccept     = $30;
  127.     tSend        = $40;
  128.     tPost        = tSend;    { alias for compatibility }
  129.  
  130. { minor command codes }
  131.  
  132.     tStart         = $00;
  133.     tTimeout    = $0C;
  134.     tTimeout1    = $0D;
  135.     tAbort        = $0E;
  136.     tAbort1        = $0F;
  137.  
  138. { misc command codes }
  139.     
  140.     tInit        = $00;
  141.     tTickle        = $01;
  142.     tDeRegister    = $02;
  143.     tRegister    = $03;
  144.     tShutdown    = $0F;
  145.  
  146. { useful values }
  147.  
  148.     tMajorMask    = $F0;
  149.     tMinorMask    = $0F;
  150.     
  151. type 
  152.  
  153.     MsgAddr = record
  154.         a : longint;            { network address - depends on transport prot }
  155.         p : longint;            { signature or program number - use longint ('APPL') }
  156.     end;
  157.  
  158.     MsgPtr = ^MsgRec;
  159.     TransportPtr = ^TransportRecord;
  160.  
  161. {    except for MsgUserRefCon all of the components are READ ONLY }
  162.  
  163.     MsgRec = record
  164.     
  165.         MsgLink            : MsgPtr;        { NetWork Processor internal use }
  166.         Msg2ndLink        : Ptr;            { NetWork Processor internal use }
  167.         
  168.         MsgResult        : integer;        { >0 busy, =0 done, <0 error }
  169.         MsgFlags        : SignedByte;    { reserved - lock & attn flags }
  170.         MsgCmd            : SignedByte;    { command (phase), see documentation }
  171.         MsgTicks        : longint;        { time (in ticks) this message will become invalid }
  172.         
  173.         MsgUserRefCon    : longint;        { reserved for NetWork Scheduler }
  174.         MsgReserved1    : longint;        { future NetWork Processor internal use }
  175.         MsgReserved2    : longint;        { future NetWork Processor internal use }
  176.         MsgReserved3    : longint;        { future NetWork Processor internal use }
  177.         
  178.         MsgTrpPtr        : TransportPtr;    { transport system used by message }
  179.         MsgTrpRefCon    : longint;        { free for transport system use }
  180.  
  181. {    message header information - all of this is transported to the destination }
  182.  
  183.         MsgSource        : MsgAddr;        { not guaranteed, use reply address }
  184.         MsgDest            : MsgAddr;    
  185.         MsgReply        : MsgAddr;
  186.         MsgCapasVerb    : longint;
  187.         MsgReference    : longint;
  188.         MsgPrioSize        : longint;
  189.         MsgCoreSize        : longint;
  190.         MsgPrioPtr        : Ptr;            { pointer to data structure allocated by application }
  191.         MsgCorePtr        : Ptr;            { pointer to data structure allocated by application }
  192.         
  193.     end;
  194.     
  195. { transport system }
  196.  
  197.     TransportRecord = record
  198.         TransportLink        : TransportPtr;    { link to next transport in queue }
  199.         TransportProc        : Ptr;            { pointer to definition proc - overlays magic }
  200.         TransportName        : StringHandle;    { name of resource - overlays header version & size }
  201.         TransportID            : longint;        { transport protocol (unique) signature }
  202.         TransportDomain        : StringHandle;    { transport domain identifier, may be NIL }
  203.         TransportAddr        : longint;        { local address of this transport system }
  204.         TransportBCAddr        : longint;        { this transports broadcast address }
  205.         TransportStart        : longint;        { first valid address }
  206.         TransportEnd        : longint;        { last valid address }
  207.         TransportMsgSize    : integer;        { size of MsgRecord for this transport system }
  208.         TransportListensRequested,            { see NetWork Transports for a discussion }
  209.         TransportListensStarted,            { of these three fields. }
  210.         TransportListensCompleted : integer;
  211.         TransportReserved    : longint;        { reserved for future use }
  212.         TransportVars        : Ptr;            { private vars, may be longint, ptr, or handle }
  213.         TransportMsgQHead    :  ^MsgPtr;        { pointer to head of queue (supplied by NetWork) }
  214.         TransportAttnRtn    : Ptr;            { pointer to attn routine (supplied by NetWork) }
  215.     end;
  216.  
  217.  
  218. { =============================================================    }
  219.  
  220. { conversion & logging }
  221.  
  222. procedure AddrToString (Addr: MsgAddr; var s: Str255);
  223. procedure MsgToString (Msg: MsgPtr; var s: Str255);
  224. procedure LogString (s : str255);
  225. procedure LogStrTime (s : str255);
  226. procedure LogMsg (Why : Str255; Msg : MsgPtr);
  227. procedure CheckError (s : str255; e : OSErr); { logs error if e <> 0 -- bad practice - to go }
  228. function Logging : boolean;
  229. procedure SetLogging (on : boolean);
  230.  
  231. { =============================================================    }
  232.  
  233. { general utilities }
  234.  
  235. procedure ProgramBreak (s : Str63);        { drop into debugger if one is installed -- SADE ? (new calls) -- to go? }
  236. function Visible : boolean;                { display a user interface ? }
  237. function Spare : boolean;                { this returns the setting of the spare flag }
  238. function TimeStamp : longint;            { randomized timestamp, should be unique for each call -- (sample code) }
  239.  
  240. { =============================================================    }
  241.  
  242. { idle manager }
  243.  
  244. procedure PreventIdle;             { tell NetWork that we are doing useful stuff - to go ? }
  245. function IdleMonitorState : integer;    { state of idle monitor }
  246. function Idle : boolean;        { is the local system idle ? }
  247. function IdleTicks : longint;     { number of ticks we have been idle, < 0 if busy }
  248.  
  249. { =============================================================    }
  250.  
  251. {    transport interface }
  252.  
  253. function IsLocal (a : longint) : boolean;    { shouldn´t be used. to go ? }
  254. function GetTransport (var TrpPtr : TransportPtr; index : integer) : OSErr; { to go ? }
  255. function GetTransportQHdr : QHdrPtr;
  256. function InstallTransport (Trp : TransportPtr) : OSErr;
  257. function RemoveTransport (Trp : TransportPtr) : OSErr;
  258.  
  259. { =============================================================    }
  260.  
  261. { address management - to go ? }
  262.  
  263. function EqAddr (a, b : MsgAddr) : boolean;
  264. function EqNode (a, b : MsgAddr) : boolean;
  265. function SetMsgAddr (a, p : longint) : MsgAddr;
  266. function GetNetWorkAddr : MsgAddr;
  267.  
  268. { =============================================================    }
  269.  
  270. { process management }
  271. {    most of the process management is done implicitly, these may
  272.     be the things you are interested in. }
  273.  
  274. var
  275.     pFileSignature : longint;    { valid after InitNetWork }
  276.     pProcessSignature : longint;{ valid after InitNetWork }
  277.  
  278. function Master : boolean;        { manually launched ? }
  279.  
  280. function GetProcessType (signature : longint; var ptyp : integer) : OSErr;
  281. function SetProcessType (signature : longint;     ptyp : integer) : OSErr;
  282. function GetIndProcess (var signature : longint; index : integer) : OSErr;
  283.  
  284. function LaunchLocalApplication (var signature : longint; 
  285.     WDRef : integer; DirID : longint; AppName : Str255) : OSErr;
  286.  
  287. { =============================================================    }
  288.  
  289. { message management }
  290.  
  291. { DumpMessages dumps all currently active messages - is this useful to applications ? }
  292.  
  293. procedure DumpMessages;
  294.  
  295. {    AvailableMsg returns the number of available messages - to go }
  296.  
  297. function AvailableMsg : integer;
  298.  
  299. {    the following procedure returns 0 if the Msg has been transferred completely
  300.     < 0 if there was an error, > 0 indicates that the Msg is still transferred 
  301.     or waiting. }
  302.   
  303. function MsgStatus (Msg : MsgPtr) : OSErr; { to go ? }
  304.  
  305. {    SignalMsg checks to see if a new or old message needs handling }
  306.  
  307. function SignalMsg (var Msg : MsgPtr) : OSErr; { useful for non app code }
  308.  
  309. {    GetMsg checks to see if there is a new message available. }
  310.  
  311. function GetIndexedMsg (var Msg : MsgPtr;
  312.                     Index : integer;    {0=1}
  313.                     PrioData : UNIV Ptr; 
  314.                     MaxPrioSize : longint) : OSErr;
  315.  
  316. {    GetMsg gets a message that has been signaled }
  317.  
  318. function GetMsg (Msg : MsgPtr;
  319.                     PrioData : UNIV Ptr; 
  320.                     MaxPrioSize : longint) : OSErr;
  321.  
  322. {    FlushMsg discards all received messages not "Got" except those with DontFlushMask set }
  323.  
  324. function FlushMsg (DontFlushMask : longint) : OsErr;
  325.  
  326. {    AcceptMsg will tell the transport system to receive the message and store 
  327.     it at the memory passed. }
  328.  
  329. function AcceptMsg (Msg : MsgPtr; 
  330.                     CoreData : UNIV Ptr; MaxCoreSize : longint) : OSErr;
  331.  
  332. {    PostMsg generates a new message that will be sent. It does not make a copy
  333.     of the information that is referenced. }
  334.  
  335. function PostMsg (var Msg : MsgPtr; Trp : TransportPtr;
  336.                      Capas, Stamp : longint; DestAddr, ReplyAddr : MsgAddr;
  337.                     PrioData : UNIV Ptr; PrioSize : longint; 
  338.                     CoreData : UNIV Ptr; CoreSize : longint) : OSErr;
  339.  
  340. {    SendMsg uses the information in RefMsg to post a new message. All of the 
  341.     fields must be filled in. The message posted is returned in NewMsg. }
  342.     
  343. function SendMsg (RefMsg : MsgPtr; var NewMsg : MsgPtr) : OSErr;
  344.  
  345.  
  346. {    ForwardMsg forwards a message to the same or another process on the same machine.
  347.     Don´t call DestroyMsg for a message you forwarded except if you forward to yourself.
  348.     ForwardMsg may be called after a GetMsg, but all buffer references will be removed }
  349.     
  350. function ForwardMsg (Msg : MsgPtr; ForwardTo : longint) : OSErr;
  351.  
  352. {    DestroyMsg gets rid of a message. This possibly kills a transfer }
  353.  
  354. function DestroyMsg (Msg : MsgPtr) : OSErr;
  355.  
  356. { =============================================================    }
  357.  
  358. { Initialization. Call InitNetWork before use of any procedure funtion
  359.   within this unit or they won´t work. If you want to use events, then
  360.   pass a event number for use (e.g. NetWorkEvt), else pass 0. }
  361.  
  362. function InitNetWork (eventno : integer) : OSErr;
  363.  
  364. { this function is obsolete and should no longer be used.
  365. function ExitNetWork : OSErr;
  366. }
  367.  
  368. implementation
  369.  
  370.  
  371. {    Copyright 1989,1990,1991 Joachim Lindenberg, Karlsruhe. All rights reserved. }
  372.  
  373. {    this file contains the interface used by driver and library to
  374.     comunicate with each other. This is included, not used }
  375.  
  376. const
  377.  
  378.     LibRelease         = '12b0';    { validity check of interface to driver,
  379.                                   changed whenever the calls or records change }
  380.     
  381. {    driver cscodes }
  382.  
  383. {    message commands }
  384.  
  385.     csGetMsg        = 200;        { get nth message received }
  386.     csSignalMsg        = 201;        { returns message with ioresult <= 0 }
  387.     csSendMsg        = 202;        { clone & send a message }
  388.     
  389.     csForwardMsg    = 206;        { forward a message }
  390.     csGetThisMsg    = 207;        { get a specific message }
  391.     csAcceptMsg        = 208;        { accept a message got }
  392.     csDestroyMsg    = 209;        { destroy a message }
  393.  
  394.     csMsgCount        = 195;        { count available messages }
  395.     csFlush            = 196;        { flush all received messages not yet got }
  396.     csDumpMsgs        = 197;        { dump all currently active messages }
  397.     csSigEvent        = 199;        { use eventnumber to signal events }
  398.  
  399. {    transport commands }
  400.     
  401.     csGetTrpQHdr    = 190;        { get transport queue header }
  402.     csInstallTrp    = 191;        { install new transport system }
  403.     csRemoveTrp        = 192;        { remove transport system }
  404.     csIsLocal         = 194;        { test if address is local }
  405.     
  406. {    process commands }
  407.  
  408.     csMsgInit        = 180;        { register a signature }
  409.     csMsgExit        = 181;        { deregister a signature }
  410.     csGetPInfo        = 182;        { get process type }
  411.     csSetPInfo        = 183;        { set process type }
  412.     csGetIProc        = 184;        { get indexed process signature }
  413.     csProcKnown        = 185;        { returns type and signature if the active process is known 
  414.                                   to NetWork, otherwise error }
  415.     csLaunchTool     = 186;        { launch program }
  416.     csKilling        = 189;        { is killing possible ? }
  417.  
  418. {    logger commands }
  419.  
  420.     csMsg2Str        = 170;        { convert a message to a string }
  421.     csAddr2Str        = 171;        { convert an address to a string }
  422.     csLoggErr        = 172;        { logs a string to the logfile }
  423.     csLoggTime        = 173;        { cLoggErr, but with time }
  424.     csLogMsg        = 174;        { log message --- was 205 }
  425.     csErr2Str        = 175;        { convert an error number to a message string }
  426.     csLogControl    = 179;        { control log file mode }
  427.  
  428. {    idle commands }
  429.  
  430.     csGetIdleTicks    = 160;        { ticks since idle }
  431.  
  432. {    misc commands }
  433.  
  434.     csGetBGOnly        = 161;        { returns visible setting }
  435.     csGetSpare        = 162;        { returns spare setting }
  436.     csCheckVers        = 163;        { version negotiation }
  437.     csIgnored        = 164;        { this command specifically ignored (used internally) }
  438.  
  439. {    cdev commands - for cdev use only }
  440.     
  441.     csCdevChange    = 165;        { settings changed - internal use of cdev only }
  442.     csCheckPath        = 166;        { test if path exists }
  443.     
  444. {    statistics - reserved - do not use because these may change with every release }
  445.  
  446.     csIdleStats        = 169;        { get idle monitor statistics }
  447.     csMsgStats        = 168;        { get message statistics }
  448.  
  449. type
  450.  
  451. {    this parameter block is used by the driver interface }
  452.  
  453.     MsgControlPtr = ^MsgControlBlock;
  454.     MsgControlBlock = record
  455.     
  456. { standard device manager header }
  457.  
  458.         qLink: QElemPtr;
  459.         qType: INTEGER;
  460.         ioTrap: INTEGER;
  461.         ioCmdAddr: Ptr;
  462.         ioCompletion: ProcPtr;
  463.         ioResult: OSErr;
  464.         ioNamePtr: StringPtr;
  465.         ioVRefNum: INTEGER;
  466.         ioRefNum: INTEGER;
  467.         csCode : integer;
  468.         
  469. {    driver specific information }
  470.  
  471.         ioSignature: longint;
  472.         ioMessage: MsgPtr;
  473.         ioIndex : integer;        { GetMsg, Get/SetProcessInfo }
  474.         ioBuffer : Ptr;            { used to pass prio/core buffer }
  475.         ioSize : longint;        { space to GetMsg/AcceptMsg }
  476.     end;
  477.  
  478. type CharPtr = ^CharArray; CharArray = packed array [0..1] of char;
  479.  
  480. {$D+} { full Macsbug symbols }
  481.  
  482. {    =============================================================    }
  483.  
  484. function EqNode (a, b : MsgAddr) : boolean;
  485. begin
  486.     EqNode := (a.a = b.a) | (IsLocal (a.a) & IsLocal (b.a));
  487. end;
  488.  
  489. function EqAddr (a, b : MsgAddr) : boolean;
  490. begin
  491.     EqAddr := (a.p = b.p) & EqNode (a, b);
  492. end;
  493.  
  494. {    =============================================================    }
  495.  
  496. {    private variables }
  497.  
  498. var
  499.     gError : OSErr;
  500.     gMiscID : longint;
  501.     gControl : MsgControlBlock; { global parameter block }    
  502.  
  503. {    general utilities }
  504.  
  505. procedure ProgramBreak (s : str63);
  506. type longptr = ^longint;
  507. begin
  508.     if (longptr ($120)^ <> 0) {| (NGetTrapAddress (_DebugStr, ToolTrap) <> NGetTrapAddress (_Unimplemented, ToolTrap))} then
  509.            DebugStr (s);
  510. end;
  511.  
  512. procedure PreventIdle;
  513. var l : longint; e : integer;
  514. begin
  515.     l := 1; e := FSWrite (gControl.ioRefNum, l, Nil); { don´t report error if old driver }
  516. end;
  517.  
  518. procedure AddrToString (Addr: MsgAddr; var s: Str255);
  519. begin
  520.     s := ''; { Driver appends -- remove this line if you want to pass a prefix string }
  521.     gControl.csCode := csAddr2Str;
  522.     gControl.ioBuffer := @s; gControl.ioMessage := @Addr;
  523.     gError := PBControl (@gControl, false);
  524. end;    
  525.  
  526. procedure MsgToString (Msg: MsgPtr; var s: Str255);
  527. begin
  528.     s := ''; { Driver appends -- remove this line if you want to pass a prefix string }
  529.     gControl.csCode := csMsg2Str;
  530.     gControl.ioBuffer := @s; gControl.ioMessage := Msg;
  531.     gError := PBControl (@gControl, false);
  532. end;    
  533.  
  534. procedure LogString (s : str255);
  535. begin
  536.     gControl.csCode := csLoggErr;
  537.     gControl.ioBuffer := @s;
  538.     gError := PBControl (@gControl, false);
  539. end;
  540.  
  541. procedure LogStrTime (s : str255);
  542. begin
  543.     gControl.csCode := csLoggTime;
  544.     gControl.ioBuffer := @s;
  545.     gError := PBControl (@gControl, false);
  546. end;
  547.  
  548. procedure LogMsg (Why : Str255; Msg : MsgPtr);
  549. begin
  550.     gControl.csCode := csLogMsg;
  551.     gControl.ioBuffer := @why;
  552.     gControl.ioMessage := Msg;
  553.     gError := PBControl (@gControl, false);
  554. end;
  555.  
  556. procedure CheckError (s : str255; e : integer);
  557. var t : str255;
  558. begin
  559.   if e = 0 then exit (CheckError);
  560.   NumToString (e, t); LogString (concat (s, ' Error # ', t));
  561. end;
  562.  
  563. function Logging : boolean;
  564. begin
  565.     gControl.csCode := csLogControl;
  566.     gControl.ioIndex := -1;
  567.     Logging := (PBControl (@gControl, false) = noErr) & (gControl.ioIndex > 0);    
  568. end;
  569.  
  570. procedure SetLogging (on : boolean);
  571. begin
  572.     gControl.csCode := csLogControl;
  573.     if on then gControl.ioIndex := maxint else gControl.ioIndex := 0;
  574.     gError := PBControl (@gControl, false);    
  575. end;
  576.  
  577. function TimeStamp : longint;
  578. var p, q : Point; l, k : longint;
  579. begin
  580.     GetDateTime (longint (p));
  581.     q.h := p.v; q.v := p.h; l := longint (q); k := TickCount;
  582.     l := BOr (l, k) - BAnd (l, k); { XOR }
  583.     if l = 0 then l := -1; { 0 reserved, though this is very unlikely }
  584.     TimeStamp := l;
  585. end;
  586.  
  587. function IsLocal (a : longint) : boolean;
  588. begin
  589.     longint (gControl.ioMessage) := a; gControl.csCode := csIsLocal;
  590.     IsLocal := PBControl (@gControl, false) = noErr
  591. end;
  592.  
  593. {    transport interface }
  594.  
  595. function GetTransportQHdr : QHdrPtr;
  596. begin
  597.     with gControl do begin
  598.         csCode := csGetTrpQHdr;
  599.         if PBControl (@gControl, false) = noErr then GetTransportQHdr := QHdrPtr (ioMessage)
  600.         else GetTransportQHdr := nil;
  601.     end;
  602. end;
  603.  
  604. function InstallTransport (Trp : TransportPtr) : OSErr;
  605. begin
  606.     with gControl do begin
  607.         csCode := csInstallTrp; TransportPtr (ioMessage) := Trp;
  608.         InstallTransport := PBControl (@gControl, false);
  609.     end;
  610. end;
  611.  
  612. function RemoveTransport (Trp : TransportPtr) : OSErr;
  613. begin
  614.     with gControl do begin
  615.         csCode := csRemoveTrp; TransportPtr (ioMessage) := Trp;
  616.         RemoveTransport := PBControl (@gControl, false);
  617.     end;
  618. end;
  619.  
  620. function GetTransport (var TrpPtr : TransportPtr; index : integer) : OSErr;
  621. var q : QHdrPtr; p : TransportPtr;
  622. begin
  623.     q := GetTransportQHdr; p := nil;
  624.     if q <> nil then begin { …else no NetWork Processor }
  625.         p := TransportPtr (q^.qHead);
  626.         while (index > 0) & (p <> nil) do begin index := index - 1; p := p^.TransportLink end;
  627.     end;
  628.     TrpPtr := p;
  629.     if p <> nil then GetTransport := noErr else GetTransport := qErr;
  630. end;
  631.  
  632. function SetMsgAddr (a, p : longint) : MsgAddr;
  633. var m : MsgAddr;
  634. begin
  635.     m.a := a; m.p := p;
  636.     SetMsgAddr := m;
  637. end;
  638.  
  639. function GetNetWorkAddr : MsgAddr;
  640. var m : MsgAddr;
  641. begin
  642.     m.a := 0; m.p := gControl.ioSignature;
  643.     GetNetWorkAddr := m;
  644. end;
  645.  
  646. {    process mangement
  647.     most of the process management is done implicitly, these may
  648.     be the two things you are interested in. }
  649.     
  650. {    visible looks at the background only bit of the current app and at the
  651.     setting of the control panel. }
  652.     
  653. function Visible : Boolean;
  654. type IntPtr = ^Integer; IntHandle = ^IntPtr;
  655. var sizehandle : IntHandle; vis : boolean;
  656. begin
  657.     sizehandle := IntHandle (GetResource ('SIZE', 0));
  658.     if sizehandle = nil then sizehandle := IntHandle (GetResource ('SIZE', -1));
  659.     if sizehandle <> nil then
  660.         if BAnd (sizehandle ^^, $0400) <> 0 then vis := false { faceless background task }
  661.         else with gControl do begin { not faceless, get control panel setting }
  662.             csCode := csGetBGOnly;
  663.             vis := PBControl (@gControl, false) <> noErr;
  664.         end;
  665.     Visible := vis
  666. end;
  667.  
  668. function Idle : Boolean;
  669. begin
  670.     Idle := IdleMonitorState > imBusy;
  671. end;
  672.  
  673. function GetProcessType (signature : longint; var ptyp : integer) : OSErr;
  674. var lcontrol : MsgControlBlock;
  675. begin
  676.     lcontrol := gControl; lcontrol.csCode := csGetPInfo;
  677.     if signature <> 0 then lcontrol.iosignature := signature;
  678.     GetProcessType :=  PBControl (@lControl, false);
  679.     ptyp := lcontrol.ioindex;
  680. end;
  681.  
  682. function SetProcessType (signature : longint;     ptyp : integer) : OSErr;
  683. var lcontrol : MsgControlBlock;
  684. begin
  685.     lcontrol := gControl; lcontrol.csCode := csSetPInfo; 
  686.     if signature <> 0 then lcontrol.iosignature := signature;
  687.     lcontrol.ioindex := ptyp;
  688.     SetProcessType :=  PBControl (@lControl, false);
  689. end;
  690.  
  691. function UseEventNo (eventcode : integer) : OSErr;
  692. begin
  693.     gControl.csCode := csSigEvent; gControl.ioIndex := eventcode;
  694.     UseEventNo := PBControl (@gControl, false);
  695. end;
  696.  
  697. function GetIndProcess (var signature : longint; index : integer) : OSErr;
  698. var lcontrol : MsgControlBlock;
  699. begin
  700.     lcontrol.csCode := csGetIProc; lcontrol.ioRefNum := gControl.ioRefNum;
  701.     lcontrol.ioindex := index;
  702.     GetIndProcess :=  PBControl (@lControl, false);
  703.     signature := lcontrol.iosignature;
  704. end;
  705.  
  706. function Master : Boolean;
  707. begin
  708.     gControl.csCode := csGetPInfo; Master := true; { in case no driver ! }
  709.     if PBControl (@gControl, false) = noErr then
  710.         Master := BAnd (gControl.ioIndex, 3) >= pMaster;
  711. end;
  712.  
  713. function Spare : boolean;        { this returns the setting of the spare flag }
  714. begin
  715.     gControl.csCode := csGetSpare; Spare := true; { in case no driver ! }
  716.     Spare := PBControl (@gControl, false) = noErr;
  717. end;
  718.  
  719. function IdleTicks : longint;    { number of ticks we have been idle }
  720. begin
  721.     gControl.csCode := csGetIdleTicks; 
  722.     if PBControl (@gControl, false) = noErr then IdleTicks := longint (gControl.ioBuffer)
  723.     else IdleTicks := -1;
  724. end;
  725.  
  726. function IdleMonitorState : integer;    { state of idle monitor }
  727. begin
  728.     gControl.csCode := csGetIdleTicks; 
  729.     if PBControl (@gControl, false) = noErr then IdleMonitorState := gControl.ioIndex
  730.     else IdleMonitorState := imBusy;
  731. end;
  732.  
  733. {    =============================================================    }
  734.  
  735. {    message handling functions }
  736.  
  737. procedure DumpMessages;
  738. begin
  739.     with gControl do begin
  740.         csCode := csDumpMsgs;
  741.         if PBControl (@gControl, false) = noErr then;
  742.     end;
  743. end;
  744.  
  745. {    return the number of available messages}
  746.  
  747. function AvailableMsg:integer;
  748. begin
  749.     with gControl do begin
  750.         ioIndex := 0; csCode := csMsgCount;
  751.         if PBControl (@gControl, false) = noErr then AvailableMsg := ioIndex
  752.         else AvailableMsg := 0;
  753.     end;
  754. end;
  755.  
  756. {    the following procedure returns 0 if the Msg has been transferred completely
  757.     < 0 if there was an error, > 0 indicates that the Msg is still transferred 
  758.     or waiting. }
  759.   
  760. function MsgStatus (Msg : MsgPtr) : integer;
  761. var err : integer;
  762. begin
  763.     if Msg <> nil then err := Msg^.MsgResult
  764.     else err := eNoSuchMsg;
  765.     MsgStatus := err;
  766. end;
  767.  
  768. {    SignalMsg checks to see if a new or old message needs handling }
  769.  
  770. function SignalMsg (var Msg : MsgPtr) : OSErr;
  771. begin
  772.     with gControl do begin
  773.         ioMessage := nil; csCode := csSignalMsg;
  774.         SignalMsg := PBControl (@gControl, false);
  775.         Msg := ioMessage;
  776.     end;
  777. end;
  778.  
  779. {    GetThisMsg gets a message that has been signaled }
  780.  
  781. function GetMsg (Msg : MsgPtr;
  782.                     PrioData : UNIV Ptr; 
  783.                     MaxPrioSize : longint) : OSErr;
  784. begin
  785.     with gControl do begin
  786.         ioBuffer := PrioData; ioSize := MaxPrioSize; ioMessage := Msg;
  787.         csCode := csGetThisMsg;
  788.         GetMsg := PBControl (@gControl, false);
  789.     end;
  790. end;
  791.  
  792. {    GetMsg checks to see if there is a new message available }
  793.  
  794. function GetIndexedMsg (var Msg : MsgPtr;
  795.                     Index : integer;
  796.                     PrioData : UNIV Ptr; 
  797.                     MaxPrioSize : longint) : OSErr;
  798. begin
  799.     with gControl do begin
  800.         ioBuffer := PrioData; ioSize := MaxPrioSize; ioMessage := nil;
  801.         ioIndex := Index; csCode := csGetMsg;
  802.         GetIndexedMsg := PBControl (@gControl, false);
  803.         Msg := ioMessage;
  804.     end;
  805. end;
  806.  
  807. {    FlushMsg discards all received messages not "Got" or "Accepted". }
  808.  
  809. function FlushMsg (DontFlushMask : longint) : OsErr;
  810. begin
  811.     with gControl do begin
  812.         csCode := csFlush; longint (ioMessage) := DontFlushMask;
  813.         FlushMsg := PBControl (@gControl, false);
  814.     end;
  815. end;
  816.  
  817. {    AcceptMsg will tell the transport system to receive the message and store 
  818.     it at the memory passed. }
  819.  
  820. function AcceptMsg (Msg : MsgPtr; 
  821.                     CoreData : UNIV Ptr; MaxCoreSize : longint) : OSErr;
  822.  
  823. begin
  824.     if Msg <> nil then with gControl do begin
  825.         ioMessage := Msg; csCode := csAcceptMsg;
  826.         ioBuffer := CoreData; ioSize := MaxCoreSize;
  827.         AcceptMsg := PBControl (@gControl, false);
  828.     end
  829.     else begin
  830.         AcceptMsg := eNoSuchMsg;
  831.         CheckError ('AcceptMsg NIL reference', eNoSuchMsg)
  832.     end;
  833. end;
  834.  
  835. {    SendMsg uses the information in RefMsg to post a new message. All of the 
  836.     fields must be filled in. The message posted is returned in NewMsg. }
  837.  
  838. function SendMsg (RefMsg : MsgPtr; var NewMsg : MsgPtr) : OSErr;
  839. var TempMsg : MsgRec;
  840. begin
  841.     with gControl do begin
  842.         csCode := csSendMsg; ioMessage := RefMsg; gError := PBControl (@gControl, false);
  843.         NewMsg := ioMessage;
  844.     end;
  845.     SendMsg := gError;
  846. end;
  847.  
  848. {    PostMsg generates a new message that will be sent. It does not make a copy
  849.     of the information that is referenced. }
  850.  
  851. function PostMsg (var Msg : MsgPtr; Trp : TransportPtr;
  852.                     Capas, Stamp : longint; DestAddr, ReplyAddr : MsgAddr;
  853.                     PrioData : UNIV Ptr; PrioSize : longint; 
  854.                     CoreData : UNIV Ptr; CoreSize : longint) : OSErr;
  855. var TempMsg : MsgRec; p : CharPtr;
  856. begin
  857.     p := @TempMsg; FillChar (p^, sizeof (TempMsg), chr (0));
  858.     with TempMsg do begin
  859. {        MsgUserRefCon := 0; }
  860.         MsgSource.p := gControl.ioSignature; 
  861.         if Trp <> nil then MsgSource.a := Trp^.TransportAddr 
  862. {        else MsgSource.a := 0 } ;
  863.         MsgTrpPtr := Trp;
  864.         MsgDest := DestAddr; MsgReply := ReplyAddr;
  865.         MsgCapasVerb := Capas; MsgReference := Stamp;
  866.         MsgPrioPtr := PrioData; MsgPrioSize := PrioSize;
  867.         MsgCorePtr := CoreData; MsgCoreSize := CoreSize;
  868.     end;
  869.     PostMsg := SendMsg (@TempMsg, Msg);
  870. end;
  871.  
  872. {    ForwardMsg forwards a message to the same or another process on the same machine.
  873.     Don´t call DestroyMsg for a message you forwarded except if you forward to yourself.
  874.     ForwardMsg may be called after a GetMsg, but all buffer references will be removed }
  875.     
  876. function ForwardMsg (Msg : MsgPtr; ForwardTo : longint) : OSErr;
  877. begin
  878.     with gControl do begin
  879.         csCode := csForwardMsg; ioMessage := Msg; longint (ioBuffer) := ForwardTo;
  880.         gError := PBControl (@gControl, false);
  881.     end;
  882.     ForwardMsg := gError;
  883. end;
  884.  
  885. function LaunchLocalApplication (var signature : longint; 
  886.     WDRef : integer; DirID : longint; AppName : Str255) : OSErr;
  887. begin
  888.     with gControl do begin
  889.         ioVRefNum := WDRef; longint (ioBuffer) := DirID; ioNamePtr := @AppName;
  890.         longint (ioMessage) := signature; csCode := csLaunchTool; 
  891.         gError := PBControl (@gControl, false); signature := longint (ioMessage); 
  892.     end;
  893.     LaunchLocalApplication := gError;
  894. end;
  895.  
  896. {    DestroyMsg gets rid of a message. This possibly kills a transfer }
  897.  
  898. function DestroyMsg (Msg : MsgPtr) : OSErr;
  899.  
  900. begin
  901.     if Msg <> nil then with gControl do begin
  902.         ioMessage := MsgPtr (Msg); csCode := csDestroyMsg;
  903.         gError := PBControl (@gControl, false);
  904.     end
  905.     else begin
  906.         DestroyMsg := eNoSuchMsg;
  907.         CheckError ('DestroyMsg NIL reference', eNoSuchMsg)
  908.     end;
  909. end;
  910.  
  911. function InitNetWork (eventno : integer) : OSErr;
  912. type CharPtr = ^CharArray; CharArray = packed array [0..1] of char;
  913. var pb : record case boolean of true : (hpb : HParamBlockRec); false : (fpb : FCBPBRec) end;
  914.     appname : Str255; h : Handle; signature : longint;
  915.     ptyp : integer;
  916. begin
  917.     if gMiscID <> 0 then ProgramBreak ('NetWork Library: Did you compile this unit with -u?');
  918.     GetAppParms (appname, pb.fpb.iorefnum, h); { in case we need to log an error below }
  919.  
  920.     with pb, fpb, hpb do begin
  921.         ioNamePtr := @appname; ioFCBIndx := 0;
  922.         if PBGetFCBInfo (@pb, false) <> noErr then ProgramBreak ('NetWork Library: GetFCBInfo failed')
  923.         else begin
  924.             ioVRefNum:= ioFCBVRefNum; { copy volume }
  925.             iodirid:= ioFCBParId; { copy dirid }
  926.             if PBHGetFInfo (@pb, false) = noErr then pFileSignature := longint (ioFlFndrInfo.fdCreator);
  927.         end;
  928.     end;
  929.  
  930.     with gControl do begin
  931.         if OpenDriver ('.Network Processor', ioRefNum) <> noErr then
  932.             gError := notOpenErr { less confusing than resource not found }
  933.         else begin
  934.             longint (ioBuffer) := longint (LibRelease); { library release }
  935.             csCode := csCheckVers;
  936.             gError := PBControl (@gControl, false);
  937.         end;
  938.     end;
  939.     
  940.     if gError = noErr then with gControl do begin
  941.         csCode := csProcKnown; { test if this process is known to NetWork Processor }
  942.         if PBControl (@gControl, false) <> noErr then begin
  943.             ioIndex := pMaster; { default }
  944.             ioSignature := pFileSignature; 
  945.         end;
  946.         if ioIndex = pUnknown then ioIndex := pMaster;
  947.     end;
  948.     if gError = noErr then with gControl do begin
  949.         csCode := csMsgInit; gError := PBControl (@gControl, false);
  950.         if gError <> noErr then ioSignature := 0
  951.         else pProcessSignature := ioSignature;
  952.     end;
  953.     if gError = noErr then gError := UseEventNo (eventno);
  954.     InitNetWork := gError;
  955.     if (gError <> noErr) then with gControl do begin
  956.         csCode := csMsgExit; gError := PBControl (@gControl, false); { clean up as much as possible }
  957.         gControl.ioRefNum := 0;  { any control call will fail }
  958.         gError := notOpenErr;
  959.     end;
  960. end;    
  961.  
  962. function ExitNetWork : OSErr;
  963. begin 
  964.     if gControl.ioRefNum = 0 then ExitNetWork := notOpenErr
  965.     else begin
  966.         gControl.csCode := csMsgExit; 
  967.         gError := PBControl (@gControl, false);
  968.         ExitNetWork := gError;
  969.         gControl.ioRefnum := 0;
  970.     end;
  971. end;
  972.  
  973. end.
  974.  
  975.  
  976.